home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Collection of Tools & Utilities
/
Collection of Tools and Utilities.iso
/
ada
/
gwuada_9.zip
/
INIT.C
< prev
next >
Wrap
C/C++ Source or Header
|
1993-07-27
|
12KB
|
434 lines
/*
* Copyright (C) 1985-1992 New York University
*
* This file is part of the Ada/Ed-C system. See the Ada/Ed README file for
* warranty (none) and distribution info and also the GNU General Public
* License for more details.
*/
#ifdef MONITOR
char MON_PACKAGE_NAME[33] = "";
#endif
#define GEN
#include "hdr.h"
#include "vars.h"
#include "gvars.h"
#include "libhdr.h"
#include "segment.h"
#include "slot.h"
#include "ifile.h"
#include "readp.h"
#include "setp.h"
#include "genp.h"
#include "miscp.h"
#include "smiscp.h"
#include "arithp.h"
#include "axqrp.h"
#include "initp.h"
static Tuple precedes_map_new();
static void init_predef_exceptions();
static void init_predef_exception(int, int, int, char *);
/* These are defined here since type Segment not known in gvars.[ch] */
Segment CODE_SEGMENT, DATA_SEGMENT, DATA_SEGMENT_MAIN;
Segment FIELD_TABLE, VARIANT_TABLE;
Tuple units_in_compilation;
/* INITALIZATIONS AND FINALIZATION
* General initialization
*/
void initialize_1() /*;initialize_1*/
{
/*
* Initializes global variables that are to be kept between the two
* phases of generation.
*/
int i;
/* initialize FIELD_TABLE and VARIANT_TABLE. These are data segments
* that are reset to be empty but are not reallocated for each unit
*/
FIELD_TABLE = segment_new(SEGMENT_KIND_DATA, 0);
VARIANT_TABLE = segment_new(SEGMENT_KIND_DATA, 0);
/* tree maps */
ivalue_1 = int_fri(1);
ivalue_10 = int_fri(10);
int_const_0 = int_const(0);
rat_value_10 = rat_fri(ivalue_1, ivalue_10);
int_const_null_task = int_const(-1);
/*initializations of variables used only by generator */
/* explicit_ref_0 is used to pass addresses to be filled in later, and
* corresponds to [0, 0] case in SETL version.
*/
explicit_ref_0 = explicit_ref_new(0, 0);
global_reference_tuple = tup_new(0);
N_SIDE(OPT_NODE) = FALSE;
/* AXQ maps: */
CODE_SEGMENT_MAP = tup_new(0);
DATA_SEGMENT_MAP = tup_new(0);
/* Global variables */
EMAP = tup_new(0);
#ifdef TBSN
PREDEF_UNITS = [[], {}];
/* These are handled using EMAP in C version */
STATIC_DEPTH = {
};
POSITION = {
};
PATCHES = {
};
EQUAL = {
};
#endif
CODE_PATCH_SET = tup_new(0);
DATA_PATCH_SET = tup_new(0);
PARAMETER_SET = tup_new(0);
RELAY_SET = tup_new(0);
#ifdef TBSN
axqfiles_read = {
'_MEMORY' };
instruction_stack = [];
deleted_instructions = 0;
BTIME = 0;
optimizable_codes = domain automat0 +/{
{x, y }
:
[x, y] in domain(automat1)+domain(automat2)};
#endif
/* Slots initialization */
/* INIT_SLOTS and MAX_INDEX are procedures in C version, defined at
* the end of this file
*/
DATA_SLOTS = tup_new(0);
CODE_SLOTS = tup_new(0);
/*
* EXCEPTION_SLOTS = { ['CONSTRAINT_ERROR', 1],
* ['NUMERIC_ERROR', 2],
* ['PROGRAM_ERROR', 3],
* ['STORAGE_ERROR', 4],
* ['TASKING_ERROR', 5]
* ['SYSTEM_ERROR', 6]
* };
*/
EXCEPTION_SLOTS = tup_new(5);
EXCEPTION_SLOTS[1] = (char *) slot_new(symbol_constraint_error, 1);
EXCEPTION_SLOTS[2] = (char *) slot_new(symbol_numeric_error, 2);
EXCEPTION_SLOTS[3] = (char *) slot_new(symbol_program_error, 3);
EXCEPTION_SLOTS[4] = (char *) slot_new(symbol_storage_error, 4);
EXCEPTION_SLOTS[5] = (char *) slot_new(symbol_tasking_error, 5);
if (!compiling_predef) {
/* if not compiling predef, make room for predef slots */
EXCEPTION_SLOTS = tup_exp(EXCEPTION_SLOTS, 15);
init_predef_exceptions();
}
PRECEDES_MAP = precedes_map_new();
compilation_table = tup_new(num_predef_units);
for (i = 1; i <= num_predef_units; i++) compilation_table[i] = (char *) i;
late_instances = tup_new(8);
late_instances[1] = strjoin("spSEQUENTIAL_IO", "");
late_instances[2] = strjoin("boSEQUENTIAL_IO", "");
late_instances[3] = strjoin("spDIRECT_IO", "");
late_instances[4] = strjoin("boDIRECT_IO", "");
late_instances[5] = strjoin("ssUNCHECKED_DEALLOCATION", "");
late_instances[6] = strjoin("suUNCHECKED_DEALLOCATION", "");
late_instances[7] = strjoin("ssUNCHECKED_CONVERSION", "");
late_instances[8] = strjoin("suUNCHECKED_CONVERSION", "");
stubs_to_write = set_new(0);
units_in_compilation = tup_new(0);
/* integer arithmetic */
/* ADA_MIN_INTEGER and ADA_MAX_INTEGER are defined in adasem vars.c */
/* 'standard' symbol table
* Warning : values are given for SETL only
* IN CASE OF CHANGES IN THESE VALUES REPORT CHANGE INTO THE
* BINDER (Initialization of idle_task data segment).
*/
}
void initialize_2() /*;initialize_2*/
{
/*
* Initializations of file, of variables depending on the option string,
* and of variables that are to be reset between the two phases
*/
Axq axq;
/* Variables */
#ifdef TBSL
STIME = time;
#endif
ada_line = 0;
NB_INSTRUCTIONS = 0;
NB_STATEMENTS = 0;
/* tree map */
if (!new_library) {
axq = (Axq) emalloct(sizeof(Axq_s), "axq");
load_library(axq);
}
}
/* print_data_segment moved to segment.c */
/* TBSL: Note that INIT_SLOTS should be a procedure, as it is a read-only
* set
* It is referenced only by select_entry once initialized, as is the case
* also with MAX_INDEX.
*/
int init_slots(int kind) /*;init_slots*/
{
int n;
if (compiling_predef) {
if (kind == SLOTS_DATA) n = 2;
else if (kind == SLOTS_CODE) n = 3;
else if (kind == SLOTS_EXCEPTION) n = 5;
else chaos("init_slots bad kind");
}
else {
if (kind == SLOTS_DATA)
n = 8;
else if (kind == SLOTS_CODE)
n = 11;
else if (kind == SLOTS_EXCEPTION) n = 15;
else chaos("init_slots bad kind");
}
return n;
}
int max_index(int kind) /*;max_index*/
{
if (kind == SLOTS_DATA) return 255;
else if (kind == SLOTS_CODE) return 32767;
else if (kind == SLOTS_EXCEPTION) return 255;
chaos("max_slots bad kind");
return 0;
}
static Tuple precedes_map_new() /*;precedes_map_new*/
{
return (tup_new(0));
}
Slot slot_new(Symbol sym, int number) /*;slot_new*/
{
Slot s;
char *sname;
s = (Slot) emalloct(sizeof(Slot_s), "slot-new");
s->slot_seq = S_SEQ(sym);
s->slot_unit = S_UNIT(sym);
sname = ORIG_NAME(sym);
/* Make copy */
s->slot_name = (sname == (char *)0) ? (char *)0 : strjoin(sname, "");
#ifdef MONITOR
#define NAMESIZE 119
{
static FILE *fp = NULL;
static char source_file[NAMESIZE], *s_file;
static char *MAIN = "main";
char *package_name;
static int length;
/***************************************************/
/* Save the file for this procedure. */
/***************************************************/
if ( fp == NULL )
{
fp = fopen( "CWKLIB.$$$", "r" );
if ( fp == NULL )
{
fprintf(stderr, "Cannot open CWKLIB\n");
}
fgets( source_file, NAMESIZE, fp );
length = strlen(source_file);
source_file[length-1] = '\0';
s_file = malloc(length * sizeof(char) );
strncpy( s_file, source_file, length );
}
s->slot_file = s_file;
/***************************************************/
/* Save the package name for this procedure. */
/***************************************************/
if ( *MON_PACKAGE_NAME == '\0' )
{
s->slot_package = MAIN;
}
else
{
length = strlen( MON_PACKAGE_NAME );
package_name = malloc( (length+1) * sizeof(char) );
strcpy( package_name, MON_PACKAGE_NAME );
s->slot_package = package_name;
}
}
#undef NAMESIZE
#endif
s->slot_number = number;
return s;
}
static void init_predef_exceptions() /*;init_predef_exceptions*/
{
/* the body of this procedure is obtained by examining the standard
* output when compiling predef! Hopefully a more rational scheme
* of initialization will be provided in the future (after validation).
* shields 11-5-85
*/
init_predef_exception(26, 1, 6, "SYSTEM_ERROR");
init_predef_exception(3, 2, 7, "STATUS_ERROR");
init_predef_exception(4, 2, 8, "MODE_ERROR");
init_predef_exception(5, 2, 9, "NAME_ERROR");
init_predef_exception(6, 2, 10, "USE_ERROR");
init_predef_exc